home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok59.lha / AmokEd_V1.02b / txt / EdLists.mod < prev    next >
Text File  |  1993-08-15  |  8KB  |  354 lines
  1. (**************************************************************************
  2.  
  3. :Program.    EdLists.mod
  4. :Contents.   Lists-module modified for AmokEd
  5. :Author.     Fridtjof Siebert, Hartmut Goebel [hG]
  6. :Language.   Oberon
  7. :Translator. AmigaOberon V2.00
  8. :History.    V1.0, 17-Jun-90 Fridtjof Siebert
  9. :History.    V1.1, 10-Jan-91 H.Goebel: AddSection...,GoForw./Backw.
  10. :History.    V1.2, 28-Mar-91   [hG] SetMark, ..Area..->..Mark..
  11. :History.    V1.3, 30 Sep 1991 [hG] + GetPred, GetSucc, Swap
  12. :History.    V1.4, 17 Oct 1991 [hG] + IsElement, GoForward/BackwardNil
  13. :Date.       17 Oct 1991 20:48:37
  14.  
  15. :Remark.     only changes to the original Module are:
  16. :Remark.       STRUCTs instead of RECORDs, STRUCT-elements exported
  17.  
  18. **************************************************************************)
  19.  
  20. MODULE EdLists;
  21.  
  22. TYPE
  23.   NodePtr* = POINTER TO Node;
  24.   Node* = STRUCT
  25.             next*, prev*: NodePtr;
  26.           END;
  27.   List* = STRUCT
  28.             head* : NodePtr;
  29.             tail* : NodePtr;
  30.             remallowed: INTEGER;
  31.           END;
  32.   Mark* = List;
  33.  
  34.   DoProc * = PROCEDURE(n: NodePtr);
  35.  
  36. (* Die DoProc darf Remove(), RemHead() und RemTail() nicht benutzen. *)
  37.  
  38.  
  39. PROCEDURE Init*(VAR list: List);
  40. BEGIN
  41.   list.head := NIL;
  42.   list.tail := NIL;
  43.   list.remallowed := 0;
  44. END Init;
  45.  
  46. (*------ Add ------------------------------*)
  47.  
  48. PROCEDURE AddHead*(VAR list: List; n: NodePtr);
  49. BEGIN
  50.   n.next := list.head;
  51.   n.prev := NIL;
  52.   IF n.next=NIL THEN list.tail   := n;
  53.                 ELSE n.next.prev := n END;
  54.   list.head := n;
  55. END AddHead;
  56.  
  57.  
  58. PROCEDURE AddTail*(VAR list: List; n: NodePtr);
  59. BEGIN
  60.   n.prev := list.tail;
  61.   n.next := NIL;
  62.   IF n.prev=NIL THEN list.head   := n;
  63.                 ELSE n.prev.next := n END;
  64.   list.tail := n;
  65. END AddTail;
  66.  
  67.  
  68. PROCEDURE AddBefore*(VAR list: List;
  69.                          n,x: NodePtr);
  70. (* fügt n vor x in die Liste ein *)
  71.  
  72. BEGIN
  73.   n.prev := x.prev;
  74.   n.next := x;
  75.   x .prev := n;
  76.   IF n.prev=NIL THEN list.head   := n
  77.                 ELSE n.prev.next := n END;
  78. END AddBefore;
  79.  
  80.  
  81. PROCEDURE AddBehind*(VAR list: List;
  82.                          n,x: NodePtr);
  83. (* fügt n hinter x in die Liste ein *)
  84.  
  85. BEGIN
  86.   n.next := x.next;
  87.   n.prev := x;
  88.   x .next := n;
  89.   IF n.next=NIL THEN list.tail   := n
  90.                 ELSE n.next.prev := n END;
  91. END AddBehind;
  92.  
  93. (*------ Remove ---------------------------*)
  94.  
  95. PROCEDURE Remove*(VAR list: List; n: NodePtr);
  96. BEGIN
  97.   IF n#NIL THEN
  98.     IF list.remallowed # 0 THEN HALT(20) END;
  99.     IF n.next#NIL THEN n.next.prev := n.prev ELSE list.tail := n.prev END;
  100.     IF n.prev#NIL THEN n.prev.next := n.next ELSE list.head := n.next END;
  101.   END;
  102. END Remove;
  103.  
  104.  
  105. PROCEDURE RemHead*(VAR list: List): NodePtr;
  106. VAR n: NodePtr;
  107. BEGIN
  108.   n := list.head; Remove(list,n); RETURN n;
  109. END RemHead;
  110.  
  111.  
  112. PROCEDURE RemTail*(VAR list: List): NodePtr;
  113. VAR n: NodePtr;
  114. BEGIN
  115.   n := list.tail; Remove(list,n); RETURN n;
  116. END RemTail;
  117.  
  118. (*------ Do Forward/Backward --------------*)
  119.  
  120. PROCEDURE DoForward*(VAR list: List; proc: DoProc);
  121. VAR n: NodePtr;
  122. BEGIN
  123.   INC(list.remallowed);
  124.   n := list.head; WHILE n#NIL DO proc(n); n := n.next END;
  125.   DEC(list.remallowed);
  126. END DoForward;
  127.  
  128.  
  129. PROCEDURE DoBackward*(VAR list: List; proc: DoProc);
  130. VAR n: NodePtr;
  131. BEGIN
  132.   INC(list.remallowed);
  133.   n := list.tail; WHILE n#NIL DO proc(n); n := n.prev END;
  134.   DEC(list.remallowed);
  135. END DoBackward;
  136.  
  137. (*------ Elements -------------------------*)
  138.  
  139. PROCEDURE Next*(VAR n: NodePtr): BOOLEAN;
  140. BEGIN
  141.   n := n.next;
  142.   RETURN n#NIL;
  143. END Next;
  144.  
  145.  
  146. PROCEDURE Previous*(VAR n: NodePtr): BOOLEAN;
  147. BEGIN
  148.   n := n.prev;
  149.   RETURN n#NIL;
  150. END Previous;
  151.  
  152.  
  153. PROCEDURE Succ*(VAR n: NodePtr);
  154. BEGIN
  155.   n := n.next;
  156. END Succ;
  157.  
  158.  
  159. PROCEDURE Pred*(VAR n: NodePtr);
  160. BEGIN
  161.   n := n.prev;
  162. END Pred;
  163.  
  164.  
  165. PROCEDURE GetSucc*(n: NodePtr): NodePtr;
  166. BEGIN
  167.   RETURN n.next;
  168. END GetSucc;
  169.  
  170.  
  171. PROCEDURE GetPred*(n: NodePtr): NodePtr;
  172. BEGIN
  173.   RETURN n.prev;
  174. END GetPred;
  175.  
  176.  
  177. PROCEDURE Head*(VAR list: List): NodePtr;
  178. BEGIN
  179.   RETURN list.head;
  180. END Head;
  181.  
  182.  
  183. PROCEDURE Tail*(VAR list: List): NodePtr;
  184. BEGIN
  185.   RETURN list.tail;
  186. END Tail;
  187.  
  188. (*------ Go Forward/Backward --------------*)
  189.  
  190. PROCEDURE GoForward*(list: List; VAR n: NodePtr; num: LONGINT);
  191. BEGIN
  192.   WHILE (num>0) AND (n#NIL) DO
  193.     n := n.next;
  194.     DEC(num);
  195.   END;
  196.   IF n=NIL THEN n:=list.tail; END;
  197. END GoForward;
  198.  
  199.  
  200. PROCEDURE GoBackward*(list: List; VAR n: NodePtr; num: LONGINT);
  201. BEGIN
  202.   WHILE (num>0) AND (n#NIL) DO
  203.     n := n.prev;
  204.     DEC(num);
  205.   END;
  206.   IF n=NIL THEN n:=list.head; END;
  207. END GoBackward;
  208.  
  209.  
  210. PROCEDURE GoForwardNil*(VAR n: NodePtr; num: LONGINT);
  211. BEGIN
  212.   WHILE (num>0) AND (n#NIL) DO
  213.     n := n.next;
  214.     DEC(num);
  215.   END;
  216. END GoForwardNil;
  217.  
  218.  
  219. PROCEDURE GoBackwardNil*(VAR n: NodePtr; num: LONGINT);
  220. BEGIN
  221.   WHILE (num>0) AND (n#NIL) DO
  222.     n := n.prev;
  223.     DEC(num);
  224.   END;
  225. END GoBackwardNil;
  226.  
  227. (*------ misc -----------------------------*)
  228.  
  229. PROCEDURE Empty*(VAR list: List): BOOLEAN;
  230. BEGIN
  231.   RETURN list.head=NIL
  232. END Empty;
  233.  
  234.  
  235. PROCEDURE IsElement*(VAR list: List; e: NodePtr): BOOLEAN;
  236. VAR
  237.   n: NodePtr;
  238. BEGIN
  239.   n := list.head;
  240.   WHILE n # NIL DO
  241.     IF n = e THEN RETURN TRUE; END;
  242.     n := n.next;
  243.   END;
  244.   RETURN FALSE;
  245. END IsElement;
  246.  
  247.  
  248. PROCEDURE CountElements*(VAR list: List): LONGINT;
  249. VAR
  250.   i: LONGINT;
  251.   n: NodePtr;
  252. BEGIN
  253.   i := 0;
  254.   n := list.head;
  255.   WHILE n#NIL DO n := n.next; INC(i) END;
  256.   RETURN i;
  257. END CountElements;
  258.  
  259.  
  260. PROCEDURE Swap*(VAR list: List; a,b: NodePtr);
  261. VAR
  262.   c: NodePtr;
  263. BEGIN
  264.   c := b.prev;
  265.   Remove(list,b);
  266.   AddBehind(list,b,a);
  267.   Remove(list,a);
  268.   IF c = NIL THEN AddHead(list,a);
  269.              ELSE AddBehind(list,c,a); END;
  270. END Swap;
  271.  
  272. (*------ marks and things around ----------*)
  273.  
  274. PROCEDURE AddMarkBefore*(VAR list: List; mark: Mark; x: NodePtr);
  275. (* fügt mark vor x in die Liste ein *)
  276.  
  277. BEGIN
  278.   mark.head.prev := x.prev;
  279.   mark.tail.next := x;
  280.   x.prev := mark.tail;
  281.   IF mark.head.prev=NIL THEN list.head := mark.head
  282.                 ELSE mark.head.prev.next := mark.head END;
  283.   INC(mark.remallowed);
  284. END AddMarkBefore;
  285.  
  286.  
  287. PROCEDURE AddMarkBehind*(VAR list: List; mark: Mark; x: NodePtr);
  288. (* fügt mark hinter x in die Liste ein *)
  289.  
  290. BEGIN
  291.   mark.tail.next := x.next;
  292.   mark.head.prev := x;
  293.   x.next := mark.head;
  294.   IF mark.tail.next=NIL THEN list.tail := mark.tail
  295.                      ELSE mark.tail.next.prev := mark.tail END;
  296.   INC(mark.remallowed);
  297. END AddMarkBehind;
  298.  
  299.  
  300. PROCEDURE AddMarkHead*(VAR list: List; mark: Mark);
  301. BEGIN
  302.   mark.tail.next := list.head;
  303.   mark.head.prev := NIL;
  304.   IF mark.tail.next=NIL THEN list.tail   := mark.tail;
  305.                 ELSE mark.tail.next.prev := mark.tail END;
  306.   list.head := mark.head;
  307.   INC(mark.remallowed);
  308. END AddMarkHead;
  309.  
  310.  
  311. PROCEDURE AddMarkTail*(VAR list: List; mark: Mark);
  312. BEGIN
  313.   mark.head.prev := list.tail;
  314.   mark.tail.next := NIL;
  315.   IF mark.head.prev=NIL THEN list.head   := mark.head;
  316.                 ELSE mark.head.prev.next := mark.head END;
  317.   list.tail := mark.tail;
  318.   INC(mark.remallowed);
  319. END AddMarkTail;
  320.  
  321.  
  322. PROCEDURE RemoveMark*(VAR list: List; mark: Mark);
  323. BEGIN
  324.   IF (mark.head#NIL) AND (mark.tail#NIL)THEN
  325.     IF list.remallowed # 0 THEN HALT(20) END;
  326.     IF mark.tail.next#NIL THEN
  327.       mark.tail.next.prev := mark.head.prev
  328.     ELSE
  329.       list.tail := mark.head.prev
  330.     END;
  331.     IF mark.head.prev#NIL THEN
  332.       mark.head.prev.next := mark.tail.next
  333.     ELSE
  334.       list.head := mark.tail.next
  335.     END;
  336.   END;
  337.   DEC(mark.remallowed);
  338. END RemoveMark;
  339.  
  340.  
  341. PROCEDURE SetMark*(VAR mark: Mark; h,t: NodePtr);
  342. BEGIN
  343.   IF (h=NIL) AND (t=NIL) THEN
  344.     mark.head := NIL; mark.tail := NIL;
  345.   ELSE
  346.     IF h#NIL THEN mark.head := h; END;
  347.     IF t#NIL THEN mark.tail := t; END;
  348.   END;
  349.   IF mark.remallowed=0 THEN mark.remallowed := 1; END;
  350. END SetMark;
  351.  
  352. END EdLists.
  353.  
  354.